home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1998 March / Macworld (1998-03) (Disk 1).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / Packages / Docprojects.tcl < prev    next >
Encoding:
Text File  |  1997-12-12  |  29.7 KB  |  974 lines  |  [TEXT/ALFA]
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  Vince's Additions - an extension package for Alpha
  4.  # 
  5.  #  FILE: "Docprojects.tcl"
  6.  #                                    created: 29/7/97 {4:59:22 pm} 
  7.  #                                last update: 12/12/97 {4:01:25 pm} 
  8.  #  Author: Vince Darley
  9.  #  E-mail: <darley@fas.harvard.edu>
  10.  #    mail: Division of Engineering and Applied Sciences, Harvard University
  11.  #          Oxford Street, Cambridge MA 02138, USA
  12.  #     www: <http://www.fas.harvard.edu/~darley/>
  13.  #  
  14.  # Copyright (c) 1997  Vince Darley
  15.  # 
  16.  # See the file "license.terms" for information on usage and redistribution
  17.  # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  18.  # ###################################################################
  19.  ##
  20.  
  21. alpha::extension documentProjects 1.5.2 {
  22.     alpha::package require Alpha 7.0b4
  23.     namespace eval Docproj {}
  24.     # dummy value
  25.     ensureset docProject(name) [list "None" "Project2" "Thesis"]
  26.     newPref var currentProject "None" Docproj "" docProject(name) "varitem"
  27.     menu::buildProc "Current Project" \
  28.       {menu::buildFlagMenu "Current Project" list currentProject DocprojmodeVars}
  29.     menu::insert global submenu 5 {Current Project}
  30.     menu::insert global items 5 \
  31.         "documentProjectPrefs…" "userDetails…" \
  32.         "<E<SremoveDocumentTemplate…" "<S<BeditDocumentTemplate…" \
  33.         "<SnewDocumentTemplate…" \
  34.         "<E<SremoveProject…" "<S<BeditProject…" "<SnewProject…"
  35.     newPref binding updateFileVersion "/f<U" Docproj
  36.     menu::insert winUtils items end \
  37.         "showInFinder" \
  38.         "(-" \
  39.         "updateDate" \
  40.         "[menu::bind DocprojmodeVars(updateFileVersion) -]"
  41.     lunion elec::MenuTemplates "createHeader" "newDocument"
  42.     catch "unbind F1 bind::Completion"
  43.     menu::insert elec items end \
  44.         {menu -n FunctionComments -p menu::generalProc {
  45.         "/eusual"    
  46.         "/e<Isimple" 
  47.         "/e<OwithAuthor" 
  48.         "/e<Uupdate" 
  49.     }}
  50.     set "newDocument::handlers(Document Projects)" Docproj::newHandler
  51.     # Use this simple proc if we don't have the newDocument package.
  52.     if {![alpha::package exists newDocument]} {
  53.         ;proc file::newDocument {} {
  54.             beep
  55.             Docproj::newHandler [list -n [statusPrompt "New doc name:"]]
  56.         }
  57.     } else {
  58.         alpha::package require newDocument
  59.     }
  60.     
  61.     # new document templates mode specific (useful if you have lots of templates)
  62.     newPref flag docTemplatesModeSpecific 1 Docproj
  63.     # Do we auto-update the header    of a file? 
  64.     newPref flag autoUpdateHeader 1 Docproj
  65.     # call on saveHook
  66.     proc Docproj::changeProject {name} {
  67.         if {$name == "*"} { return }
  68.         menu::flagProc "Current Project" $name
  69.     }
  70.     
  71.     # call on saveHook
  72.     hook::register saveHook updateHeaderHook
  73. } maintainer {
  74.     "Vince Darley" darley@fas.harvard.edu <http://www.fas.harvard.edu/~darley/>
  75. } uninstall {this-file} help {file "Documentprojects Help"}
  76.  
  77. # user projects
  78. if ![info exists docProject(addendum)] {
  79.     set docProject(addendum) { {none} {about some other stuff} {deep problems}}
  80.     set docProject(default_modes) { {} {C++ Tcl} {TeX}}
  81.     set docProject(extra) [list "" "Freely distributable" "Copyright (C) 1997 the author."]
  82.     set docProject(license) [list "" "" ""]
  83. }
  84.  
  85.  
  86. proc updateHeaderHook name {
  87.     global DocprojmodeVars
  88.     if $DocprojmodeVars(autoUpdateHeader) {
  89.         # update does no harm if it fails so we call it for all
  90.         # modes with no worries.
  91.         getWinInfo -w $name a
  92.         if $a(dirty) {
  93.             file::updateDate $name
  94.         }
  95.     }
  96. }
  97.  
  98. # header/source templates (NOTE: FORMAT OF THIS LIST MAY CHANGE)
  99. llunion elec::DocTemplates 1 \
  100.     { * "Empty" * "" *} \
  101.     { * "Default" * t_default *} \
  102.     { TeX "Basic LaTeX document" "None" t_latex * {article report letter book slides}} \
  103.     { C++ "Basic C++ header file" "Header" t_cpp_header * } \
  104.     { C++ "Basic C++ source file" "Source" t_cpp_source * } \
  105.     { HTML "HTML document" * t_html * } 
  106.     ## 
  107.      # \
  108.      # { C++ "Cpptcl Class Source" Source t_cpptcl_source "Cpptcl"} \
  109.      # { C++ "Cpptcl Class Header" Header t_cpptcl_header "Cpptcl"} \
  110.      # { Tcl "Itcl Class" * t_itcl_class "Cpptcl"}  \
  111.      # { Tcl "Blank Tcl Header" Header "\#" "Vince's Additions"} \
  112.      # { C++ "EvoX Class Source" Source t_cpptcl_source "EvoX"} \
  113.      # { C++ "EvoX Class Header" Header t_cpptcl_header "EvoX"}
  114.      ##
  115.  
  116. # used for file description headers
  117. if $synchroniseWithInternetConfig {
  118.     catch {set user(author) [icGetPref RealName]}
  119.     catch {set user(email) "<[icGetPref Email]>"}
  120.     catch {set user(www) "<[icGetPref WWWHomePage]>"}
  121.     catch {set user(organisation) [icGetPref Organization]}
  122. } 
  123. ensureset user(author) "Ken McKen"
  124. ensureset user(email) "ken@kenny.com"
  125. ensureset user(www) "http://www.kenny.com/"
  126. ensureset user(organisation) "Ken Corp."
  127.  
  128. ensureset user(address) "Rose St, MA 02143, USA"
  129. ensureset user(author_initials) "VMD"
  130.  
  131. ## 
  132.  # ###################################################################
  133.  #    Used to be "docProjEngine.tcl", now one file:
  134.  # ###################################################################
  135.  ##
  136.  
  137. proc global::userDetails {} {
  138.     dialog::pkg_options "Docprojects" \
  139.         "User Details (some maye be from Internet Config)" 1 user
  140. }
  141. proc global::documentProjectPrefs {} {
  142.     dialog::pkg_options "Docproj" "Preferences for your Document Projects"
  143. }
  144.  
  145. proc Docproj::newHandler {args} {
  146.     set doc [file::createDocument "new $args"]
  147.     if {[getModifiers] & 72} {
  148.         file::pickProject
  149.     }
  150.     file::createHeader $doc
  151.     return ""
  152. }
  153.  
  154. proc file::pickProject {} {
  155.     global DocprojmodeVars docProject
  156.     set item [listpick -p "Pick a project…" -L $DocprojmodeVars(currentProject) \
  157.         $docProject(name)]
  158.     if {$item != ""} { Docproj::changeProject $item }
  159.     return $item
  160. }
  161.  
  162. proc file::projectName {} { 
  163.     global DocprojmodeVars
  164.     return $DocprojmodeVars(currentProject)
  165. }
  166.  
  167. proc file::projectAddendum {} {
  168.     global docProject DocprojmodeVars
  169.     return [lindex $docProject(addendum) \
  170.         [lsearch -exact $docProject(name) $DocprojmodeVars(currentProject)]]
  171. }
  172.  
  173. proc file::projectExtra {} {
  174.     global docProject DocprojmodeVars
  175.     return [lindex $docProject(extra) \
  176.         [lsearch -exact $docProject(name) $DocprojmodeVars(currentProject)]]
  177. }
  178. proc file::projectLicense {} {
  179.     global docProject DocprojmodeVars
  180.     set ret [lindex $docProject(license) \
  181.         [lsearch -exact $docProject(name) $DocprojmodeVars(currentProject)]]
  182.     if {$ret == ""} {
  183.         return "none"
  184.     } else {
  185.         return $ret
  186.     }
  187. }
  188.  
  189. namespace eval functioncomments {}
  190.  
  191. ## 
  192.  # ----------------------------------------------------------------------
  193.  #     
  194.  #    "file::functionComment" --
  195.  #    
  196.  #     This procedure    generates a    nice little    comment    box
  197.  #     like this one here.
  198.  #    
  199.  #    Results:
  200.  #     Well it doesn't return    anything, but it allows    you    to
  201.  #     enter each    item simply, moving    from one to the next with Tab
  202.  #    
  203.  #    Side effects:
  204.  #     Not much
  205.  #    
  206.  # ----------------------------------------------------------------------
  207.  ##
  208. proc functioncomments::usual { {simple ""} {author 0} } {
  209.     global user
  210.     set fn [getSelect]
  211.     set fn [lindex $fn end]
  212.     beginningOfLine
  213.     set t "-------------------------------------------------------------------------\r"
  214.     append t "\r"
  215.     append t "\"$fn\" --\r"
  216.     append t "\r •description•\r"
  217.     if { $simple != "simple" } {
  218.         append t "\rResults:\r •results•\r\rSide effects:\r •side effects•\r"
  219.     }
  220.     if $author {
  221.         append t "\r--Version--Author------------------Changes-------------------------------"
  222.         append t "\r   1.0     $user(email) original\r"
  223.     }
  224.     append t "-------------------------------------------------------------------------"
  225.     set t [file::commentTextBlock $t]
  226.     elec::CenterInsertion $t
  227. }
  228.  
  229. proc functioncomments::simple {} { return [functioncomments::usual simple 0]}
  230. proc functioncomments::withAuthor {} { return [functioncomments::usual "" 1] }
  231.  
  232. proc file::commentTextBlock {text} {
  233.     set cc [commentCharacters "Paragraph"]
  234.     set c [lindex $cc 2]
  235.     regsub -all "(\r|\n)" $text "\r${c}" text
  236.     return "[lindex $cc 0]\r[lindex $cc 2]${text}\r[lindex $cc 1]\r"
  237. }
  238.  
  239. ## 
  240.  # -------------------------------------------------------------------------
  241.  #     
  242.  #    "file::functionCommentUpdate" --
  243.  #    
  244.  #     Handles updating of a version line    like the one below
  245.  #    
  246.  # --Version--Author------------------Changes-------------------------------  
  247.  #      1.0      <darley@fas.harvard.edu> original
  248.  #    1.1     <darley@fas.harvard.edu> quickly updated with shift-F1
  249.  # -------------------------------------------------------------------------
  250.  ##
  251. proc functioncomments::update {} {
  252.     global user
  253.     set begin [lindex [commentCharacters Paragraph] 2]
  254.     goto [file::findLocally "${begin}--Version--Author"]
  255.     goto [nextLineStart [nextLineStart [getPos] ]]
  256.     goto [file::findLocally "${begin}-------"]
  257.     elec::Insertion "${begin}   •Version•     $user(email) •Changes•\r"
  258. }
  259.  
  260. ## 
  261.  # -------------------------------------------------------------------------
  262.  #     
  263.  #    "file::findLocally" --
  264.  #    
  265.  #     Looks around for a    particular sequence    of characters (or a    regexp)
  266.  #     and returns the start of the closest fit, either fowards or backwards,
  267.  #     or    "" if no match was found.
  268.  # -------------------------------------------------------------------------
  269.  ##
  270. proc file::findLocally { chars {regexp 0} { pos "" } } {
  271.     if { $pos == "" } { set pos [getPos] }
  272.     
  273.     set found1 [lindex [search -s -f 0 -n -r $regexp -- "$chars" $pos] 0]
  274.     set found2 [lindex [search -s -f 1 -n -r $regexp -- "$chars" $pos] 0]
  275.     
  276.     if { $found1 != "" && $found2 != "" } { 
  277.         if [expr ($pos - $found1) <= ($found2 - $pos) ] {
  278.             return $found1
  279.         } else {
  280.             return $found2
  281.         }
  282.     }
  283.     
  284.     # return whatever we can, possibly ""
  285.     if { $found1 != "" } {
  286.         return $found1
  287.     } else {
  288.         if { $found2 == "" } { 
  289.             message "Couldn't find: $chars"
  290.         }
  291.         return $found2
  292.     }
  293. }
  294.  
  295.  
  296. ## 
  297.  # -------------------------------------------------------------------------
  298.  #     
  299.  #    "file::updateFileVersion"    --
  300.  #    
  301.  #     Update    the    version    number and information in the header block
  302.  #     of    a file.  Copes with both my old and new formats.
  303.  #    
  304.  # -------------------------------------------------------------------------
  305.  ##
  306. proc file::updateFileVersion {} {
  307.     global user
  308.     # in case the user wishes to return quickly
  309.     pushPosition
  310.     
  311.     goto 0
  312.     set begin [lindex [commentCharacters Paragraph] 2]
  313.     set pos [file::findLocally "_/_/_" 0]
  314.     if { $pos == "" || $pos > 1000 } {
  315.         set srch [quote::WhitespaceReg [quote::Regfind "${begin} " ]]
  316.         append srch {[0-9]+/[0-9]+/[0-9]+}
  317.         set pos [file::findLocally $srch 1]
  318.         if { $pos == "" } {
  319.             message "Couldn't find original version template."
  320.             set srch [quote::Regfind "${begin} "]
  321.             append srch "See header file for further information"
  322.             set pos [file::findLocally [quote::WhitespaceReg $srch]]
  323.             if { $pos != "" } {
  324.                 set pos [nextLineStart $pos]
  325.             } else {
  326.                 goto 0
  327.                 set pos [file::findLocally "${begin}\#\#\#"]
  328.                 if { $pos == "" } { message "Couldn't find any header" ; return }
  329.                 set pos [lindex [search -s -f 1 -n -- "${begin}\#\#\#" [nextLineStart $pos]] 0]
  330.                 if { $pos == "" } { message "Couldn't find any header" ; return }
  331.             }
  332.             goto $pos
  333.             set t  "${begin}\r"
  334.             append t  "${begin} modified by  rev reason\r"
  335.             append t  "${begin} -------- --- --- -----------\r"
  336.             append t  "${begin} [file::paddedDate] $user(author_initials) 1.0 original\r"
  337.             insertText $t
  338.             select $pos [getPos]
  339.             return ""
  340.         } else {
  341.             # This is the normal case.
  342.             # Find the last version number
  343.             set p -1
  344.             while { $p != $pos } {
  345.                 set pos $p
  346.                 set p [file::findLocally $srch 1 [nextLineStart $p] ]
  347.             }
  348.             set pos [nextLineStart $pos]
  349.         }    
  350.     } else {
  351.         # old style header
  352.         set pos [lineStart $pos]
  353.         replaceText $pos [nextLineStart $pos] ""
  354.     }
  355.     # Now pos is at the start of the line where we wish to insert
  356.     goto $pos
  357.     elec::Insertion "${begin} [file::paddedDate] $user(author_initials) •• ••\r"
  358.     message "Pop position to return to where you were."
  359.     return ""
  360. }
  361.  
  362. proc file::paddedDate {{when ""}} {
  363.     if {$when == ""} { set when [now] }
  364.     return [string range "[lindex [mtime $when short] 0]     " 0 7]
  365. }
  366.  
  367. proc file::created {{convert 1}} {
  368.     if [catch {getFileInfo [win::Current] info}] {
  369.         if $convert {
  370.             return [mtime [now]]
  371.         } else {
  372.             return [now]
  373.         }
  374.     } else {
  375.         if $convert {
  376.             return [mtime $info(created)]
  377.         } else {
  378.             return $info(created)
  379.         }
  380.     }        
  381. }
  382.  
  383.  
  384. ## 
  385.  # -------------------------------------------------------------------------
  386.  #     
  387.  #    "file::createHeader" --
  388.  #    
  389.  #     Insert    a descriptive header into the current file.     Needs to be tailored 
  390.  #     more to different modes, but isn't    too    bad    right now.
  391.  #     
  392.  #     'forcemode' will force    the    file into that mode    via    emacs-like mode
  393.  #     entries on    the    top    line of    the    file. 
  394.  #     
  395.  #     'parent' gives    the    name of    a class    from which the generated file
  396.  #     descends (appropriate for C++,    [incr Tcl] for example).
  397.  # 
  398.  # -------------------------------------------------------------------------
  399.  ##
  400. proc file::createHeader { {template ""} {parent "" } } {
  401.     # Make sure the current project is compatible with this mode
  402.     file::coordinateProjectForMode
  403.     if {$parent == ""} {set parent "•parent•"}
  404.     if {$template == ""} { set template [list "" "" "Header" "\#" "" ""] }
  405.     # make the header
  406.     if {[lindex $template 1] != "Empty" } {
  407.         set t ""
  408.         set class [file::className]
  409.         if {$class == "Untitled"} {set class "•class name•"}
  410.         set file [win::CurrentTail]
  411.         set docHeadType [lindex $template 2]
  412.         if {$docHeadType != "None" } {
  413.             append t [file::topHeader]
  414.             if {$docHeadType != "Basic"} {
  415.                 if {$docHeadType == "Source" || [file::isSource $file]} {
  416.                     # it's a source file
  417.                     append t " See header file for further information\r"
  418.                 } elseif {$docHeadType == "Header" || $docHeadType == "*" && [file::isHeader $file]} {
  419.                     global user
  420.                     append t " Description: \r"
  421.                     append t "\r"
  422.                     append t " History\r"
  423.                     append t "\r"
  424.                     append t " modified by  rev reason\r"
  425.                     append t " -------- --- --- -----------\r"
  426.                     append t " [file::paddedDate [file::created 0]] $user(author_initials) 1.0 original\r"
  427.                 } else {
  428.                     # not header or source or basic... oh well!
  429.                 }
  430.             }
  431.             append t "###################################################################"
  432.             set t [file::commentTextBlock $t]
  433.             global mode
  434.             regsub "\r" $t "-*-${mode}-*-\r" t
  435.         }
  436.         set procName [lindex $template 3]
  437.         if {$procName != "\#" && [info commands $procName] == ""} { 
  438.             global PREFS
  439.             if [catch {uplevel \#0 source \{$PREFS:prefs.tcl\}}] {
  440.                 alertnote "An error occurred while loading \"prefs.tcl\"" 
  441.                 global errorInfo
  442.                 dumpTraces "prefs.tcl error" $errorInfo
  443.                 error ""
  444.             }            
  445.         }
  446.         if [catch {append t [eval $procName [list $class] [list $parent] [lindex $template 5]]}] {
  447.             alertnote "An error occurred while calling \"$procName\"" 
  448.             global errorInfo
  449.             dumpTraces "$procName error" $errorInfo
  450.             error ""
  451.         }
  452.         goto 0
  453.         elec::Insertion $t
  454.     }
  455.     return ""
  456. }
  457.  
  458. ## 
  459.  # -------------------------------------------------------------------------
  460.  #     
  461.  #    "file::createDocument" --
  462.  #    
  463.  #     Make a new document from a given template type.
  464.  #     
  465.  #     'forcemode' will force    the    file into that mode    via    emacs-like mode
  466.  #     entries on    the    top    line of    the    file. 
  467.  #     
  468.  # -------------------------------------------------------------------------
  469.  ##
  470. proc file::createDocument { {winCreate ""} {forcemode "" } } {
  471.     # pick a template
  472.     # if [fileIsHeader    $file]
  473.     global elec::DocTemplates mode DocprojmodeVars
  474.     # decide if its mode-specific or not
  475.     set f [lindex $winCreate 2]
  476.     if $DocprojmodeVars(docTemplatesModeSpecific) {
  477.         if {$forcemode != ""} {
  478.             set tlist [file::docTemplates $f $forcemode non]
  479.         } else {
  480.             set tlist [file::docTemplates $f $mode non]
  481.         }
  482.     } else {
  483.         set tlist [file::docTemplates $f "" non]
  484.     }
  485.     lappend tlist "<Create new document type>"
  486.     if {$non != ""} {
  487.         eval lappend tlist "----------------------------------------------------" [lsort $non]
  488.     }
  489.     set tchoice [listpick -p "Pick a document template to insert" -L "Default" $tlist]
  490.     if {$tchoice == "<Create new document type>"} {
  491.         set tchoice [file::newDocumentTemplate 1]
  492.     }
  493.     if {$tchoice == "----------------------------------------------------"} { error "" }
  494.     
  495.     set tinfo [file::docTemplateInfo $tchoice]
  496.     set subTypes [lindex $tinfo 5]
  497.     if {$subTypes != ""} {
  498.         # replace the list of options with just the one selected
  499.         set tinfo [lreplace $tinfo 5 5 [listpick -p "Pick a document subtype of $tchoice" $subTypes]]
  500.     }
  501.     if {$forcemode == "" && [lindex $tinfo 0] != "*"} {
  502.         set forcemode [lindex $tinfo 0]
  503.     }
  504.     if {$winCreate != ""} {
  505.         eval $winCreate
  506.     }
  507.     
  508.     if { $forcemode != "" && $mode != $forcemode} { 
  509.         changeMode $forcemode
  510.     }
  511.     # we need to do this to stop modes switching later if this file isn't
  512.     # obviously a '$mode' file.
  513.     global win::Modes
  514.     set win::Modes($f) $mode
  515.     # set the project
  516.     Docproj::changeProject [lindex $tinfo 4]
  517.     # if the current project doesn't like this mode, then switch
  518.     file::coordinateProjectForMode
  519.     return $tinfo
  520. }
  521.  
  522. proc file::docTemplates { {f ""} {modeSpecific ""} {other ""}} {
  523.     global elec::DocTemplates
  524.     if {$other != ""} { upvar $other noList }
  525.     set tlist ""
  526.     set noList ""
  527.     if {$f != "" && $f != "Untitled"} {
  528.         set m [file::whichModeForWin $f]
  529.         foreach t ${elec::DocTemplates} {
  530.             if [file::docTemplateMatchExt $t $f $m] {
  531.                 lappend tlist [lindex $t 1]
  532.             } else {
  533.                 lappend noList [lindex $t 1]
  534.             }
  535.         }        
  536.     } else {
  537.         foreach t ${elec::DocTemplates} {
  538.             if {$modeSpecific == "" || [string match [lindex $t 0] $modeSpecific]} {
  539.                 lappend tlist [lindex $t 1]
  540.             } else {
  541.                 lappend noList [lindex $t 1]
  542.             }
  543.         }        
  544.     }    
  545.     return [lsort $tlist]
  546. }
  547.  
  548. proc file::docTemplateMatchExt {t f {m ""}} {
  549.     if {$m == ""} {set m [file::whichModeForWin $f]}
  550.     # match everything to a file with no particular extension
  551.     if {$m == "Text"} { return 1 }
  552.     set l [lindex $t 0]
  553.     set mMatch [expr [lsearch -exact $l $m] != -1]
  554.     switch [lindex $t 2] {
  555.         "None" -
  556.         "Basic" -
  557.         "*" {
  558.             if {$l == "*"} {
  559.                 return 1
  560.             } else {
  561.                 return $mMatch
  562.             }
  563.         }
  564.         "Header" {
  565.             if {$mMatch} {
  566.                 return [file::isHeader $f $m]
  567.             }
  568.         }
  569.         "Source" {
  570.             if {$mMatch} {
  571.                 return [file::isSource $f $m]
  572.             }
  573.             
  574.         }
  575.     }
  576.     return 0
  577. }
  578.  
  579. proc file::docTemplateInfo {name} {
  580.     global elec::DocTemplates
  581.     foreach t ${elec::DocTemplates} {
  582.         if {$name == [lindex $t 1]} {
  583.             return $t
  584.         }
  585.     }
  586. }
  587. proc file::docTemplateIndex {name} {
  588.     set i 0
  589.     global elec::DocTemplates
  590.     foreach t ${elec::DocTemplates} {
  591.         if {$name == [lindex $t 1]} {
  592.             return $i
  593.         }
  594.         incr i
  595.     }
  596. }
  597.  
  598. proc file::notTextMode {} {
  599.     global mode modeMenus
  600.     if { $mode == "Text" } {
  601.         # we probably don't want Text mode     
  602.         set m [listpick -p "Pick a mode:" -L "Text" [array names modeMenus]]
  603.         if { $m == "" } {set m "Text"}
  604.         changeMode $m
  605.     } 
  606. }
  607.  
  608. ## 
  609.  # -------------------------------------------------------------------------
  610.  #     
  611.  #    "file::topHeader"    --
  612.  #    
  613.  #     Inserts the top part of a    descriptive    header into    the    current    file
  614.  # -------------------------------------------------------------------------
  615.  ##
  616. proc file::topHeader { } {
  617.     global user
  618.     set file [win::CurrentTail]
  619.     if [catch {getFileInfo [win::Current] info}] {
  620.         set created [mtime [now]]
  621.         set last_update $created
  622.     } else {
  623.         set created [mtime $info(created)]
  624.         set last_update [mtime $info(modified)]
  625.     }        
  626.     append t "###################################################################\r"
  627.     if {[file::projectName] != "*"} {
  628.         append t " [file::projectName] - [file::projectAddendum]\r"
  629.     }
  630.     append t "\r" 
  631.     append t " FILE: \"" $file "\"\r"
  632.     append t "                                   created: $created \r"
  633.     append t "                               last update: $last_update \r"    
  634.     append t " Author: $user(author)\r"
  635.     append t " E-mail: $user(email)\r"
  636.     if {$user(organisation) != ""} {
  637.         append t "   mail: $user(organisation)\r"
  638.     }
  639.     if {$user(address) != ""} {
  640.         append t "         $user(address)\r"
  641.     }
  642.     if {$user(www) != ""} {
  643.         append t "    www: $user(www)\r"
  644.     }
  645.     append t " \r"
  646.     append t [file::[file::projectLicense]]
  647.     if {[set e [file::projectExtra]] != ""} {
  648.         append t "[breakIntoLines $e]\r \r"
  649.     }
  650.     return $t
  651. }
  652.  
  653. ## 
  654.  # -------------------------------------------------------------------------
  655.  #     
  656.  #    "file::className"    --
  657.  #    
  658.  #     Extract root of file name as a    class name for the file    (obviously most    
  659.  #     relevant to C++)  
  660.  # -------------------------------------------------------------------------
  661.  ##
  662. proc file::className {} { return [file::baseName [win::CurrentTail]] }
  663.  
  664.  
  665. ## 
  666.  # -------------------------------------------------------------------------
  667.  #   
  668.  #  "file::coordinateProjectForMode" --
  669.  #  
  670.  #   When we create a new file or header automatically, it contains
  671.  #   information about our current project (as defined in docProject(...)).
  672.  #   Unfortunately we often forget to select the correct project first.
  673.  #   This procedure makes sure that your project is compatible with the
  674.  #   current mode, given the information in the 'docProject' array. If it isn't
  675.  #   then the current project is changed if a better match can be found. 
  676.  #         
  677.  #  Results:
  678.  #   None
  679.  #  
  680.  #  Side effects:
  681.  #   The current project may be changed
  682.  # -------------------------------------------------------------------------
  683.  ##
  684. proc file::coordinateProjectForMode {} {
  685.     global mode docProject
  686.     set currProj [file::projectName]
  687.     set projModes [lindex $docProject(default_modes) \
  688.         [lsearch -exact $docProject(name) [file::projectName]]]
  689.     if { $projModes != "" && [lsearch -exact $projModes $mode] == -1 } {
  690.         # this project doesn't like this mode.
  691.         # see if there's a better one
  692.         foreach modeLists $docProject(default_modes) {
  693.             if { [lsearch -exact $modeLists $mode] != -1 } {
  694.                 # found a fit
  695.                 set index [lsearch -exact $docProject(default_modes) $modeLists]
  696.                 set proj [lindex $docProject(name) $index]
  697.                 Docproj::changeProject "$proj"
  698.                 return
  699.             }
  700.         }
  701.     }
  702. }
  703.  
  704. proc file::createNewClass {} {
  705.     global mode
  706.     # if the current project doesn't like this mode, then switch
  707.     file::coordinateProjectForMode
  708.     beep
  709.     set class [statusPrompt "A name for the new class:"]
  710.     set parent [statusPrompt "Descended from:" ]
  711.     switch $mode {
  712.         "C" -
  713.         "C++" {
  714.             file::createHeader [file::createDocument "new -n ${class}.cc" C++] $parent
  715.             file::createHeader [file::createDocument "new -n ${class}.h" C++] $parent
  716.         } 
  717.         "Tcl" {
  718.             file::createHeader [file::createDocument "new -n ${class}.tcl" Tcl] $parent
  719.         }
  720.         default {
  721.             message "No class procedure defined for your mode. Why not write one yourself?"
  722.         }
  723.         
  724.     }            
  725.             
  726. }
  727.  
  728.  
  729. ## 
  730.  # -------------------------------------------------------------------------
  731.  #   
  732.  # "file::updateGeneralDate" --
  733.  #  
  734.  #  Updates the date in the header of a file.  Normally this is the 
  735.  #  'last update' date, but we can override that if desired.
  736.  # -------------------------------------------------------------------------
  737.  ##
  738. proc file::updateGeneralDate { name {patt ""} {time ""}} {
  739.     if {$patt == ""} {set patt {last update: }}
  740.     regsub -all { } $patt {[ \t]} spatt
  741.     set pos [getPos]
  742.     set end [selEnd]
  743.     set hour {[0-9][0-9]?(:|\.)[0-9][0-9]((:|\.)[0-9][0-9])?([ \t][APap][Mm])?}
  744.     set date {[0-9][0-9]?(/|\.|\-)[0-9][0-9]?(/|\.|\-)[0-9][0-9]([0-9][0-9])?}
  745.     append spatt {[ \t]*} $date {[ \t]\{?} $hour {\}?}
  746.     if [catch {search -s -f 1 -r 1 -m 0 -l 1000 $spatt 0} datePos] {return}
  747.     if {$time == ""} {set time [mtime [now] short]}
  748.     if {[eval getText $datePos] == $time} {return}
  749.     eval replaceText $datePos [list $patt $time]
  750.     select $pos $end
  751.     return
  752. }
  753.  
  754. proc file::updateDate { {name ""} } {
  755.     set fr [win::Current]
  756.     if { $name == "" } {
  757.         set name $fr
  758.     }
  759.     if { $name != $fr } {
  760.         bringToFront $name
  761.         file::updateGeneralDate $name
  762.         bringToFront $fr
  763.     } else {
  764.         file::updateGeneralDate $name
  765.     }    
  766. }
  767.  
  768. proc file::updateCreationDate { name } {
  769.     if [catch {getFileInfo [stripNameCount [win::Current]] info}] {
  770.         set created [mtime [now]]
  771.     } else {
  772.         set created [mtime $info(created)]
  773.     }        
  774.     file::updateGeneralDate $name "created" $created
  775. }
  776.  
  777. proc file::newFunction {} {
  778.     elec::Insertion "[file::className]::•name•(•args•){\r\t•body•\r}\r"
  779. }
  780.  
  781. proc global::newDocumentTemplate { {subCall 0} } {
  782.     set newT [global::_editDocumentTemplate]
  783.     global elec::DocTemplates 
  784.     lappend elec::DocTemplates $newT
  785.     # save it permanently
  786.     global modifiedVars
  787.     lappend modifiedVars elec::DocTemplates
  788.     # add template to "prefs.tcl"
  789.     set procedure [lindex $newT 3]
  790.     set subproj [lindex $newT 5]
  791.     if {$procedure != "\#"} {
  792.         set def [file::_getDefault "Do you want to use this as the template?"]
  793.         set t "\r"
  794.         append t "proc $procedure \{docname parentdoc"
  795.         if {$subproj != ""} { append t " subtype " }
  796.         append t "\} \{\r"
  797.         append t "\t# You must fill this in\r"
  798.         if {$subproj != ""} { append t "\t# Possible 'subtypes' are: $subproj\r" }
  799.         append t $def
  800.         append t "\r\treturn \$t\r\}\r"
  801.         addUserLine $t
  802.         if {[askyesno "I've added a template for the procedure to your 'prefs.tcl'. Do you want to edit it now?"] == "yes"} {
  803.             global::editPrefsFile
  804.             goto [maxPos]
  805.             if $subCall { 
  806.                 alertnote "Once you've finished editing, hit cmd-N to go back and create a new document." 
  807.                 # so our calling proc stops
  808.                 error "Editing"
  809.             }
  810.         }
  811.     }
  812.     return [lindex $newT 1]
  813. }
  814.  
  815. proc file::_varValue {var} {
  816.     upvar $var a
  817.     if [info exists a] {
  818.         return $a
  819.     } else {
  820.         return ""
  821.     }
  822. }
  823.  
  824. proc file::_getDefault { text {default ""} {var "t"}} {
  825.     if [isSelection] {
  826.         if {[askyesno "I notice you've selected some text. $text"] == "yes"} {
  827.             set default [getSelect]
  828.         } 
  829.     }
  830.     if {$default == ""} {
  831.         set default [getline "Enter template text (you can edit it later)" $default]
  832.     }
  833.     return [elec::_MakeIntoInsertion $default $var]
  834. }
  835.  
  836. proc global::_editDocumentTemplate {{def ""}} {
  837.     global DocprojmodeVars
  838.     if {$def == ""} {
  839.         set title "Create a new document template" 
  840.         set def {"" "" "By File Extension" "t_XXX" $DocprojmodeVars(currentProject) ""}
  841.         set new 1
  842.     } else {
  843.         set title "Edit document template" 
  844.         set new 0
  845.     }
  846.     
  847.     global docProject
  848.     set name ""
  849.     while { $name == ""} {
  850.         set y 40
  851.         set yb 220
  852.         set res [eval dialog -w 380 -h 340 \
  853.         [dialog::title $title 380] \
  854.         [dialog::button "OK" 290 yb] \
  855.         [dialog::button "Cancel" 290 yb] \
  856.         [dialog::textedit "Descriptive Name" [lindex $def 1] 10 y 15] \
  857.         [dialog::textedit "Modes (blank = all)" [lindex $def 0] 10 y 15] \
  858.         [dialog::textedit "Procedure name" [lindex $def 3] 10 y 15] \
  859.         [dialog::text "Descriptive header for this document template" 10 y] \
  860.         [dialog::text "(if 'Source', or 'Header', the mode must define" 10 y] \
  861.         [dialog::text "headerSuffices and sourceSuffices vars)" 10 y] \
  862.         [dialog::menu 10 y [list "None" "-" "Basic" "Source" "Header" "Either"] [lindex $def 2]] \
  863.         [dialog::text "Project name" 10 y] \
  864.         [dialog::menu 10 y $docProject(name) [lindex $def 4]] \
  865.         [dialog::textedit "List of sub-types" [lindex $def 5] 10 y 30] \
  866.         ]
  867.         if [lindex $res 1] { error "Cancel" } 
  868.         set i 1
  869.         foreach var {name modes procedure filetype proj subproj} {
  870.             set $var [lindex $res [incr i]]
  871.         }
  872.         if {$name == ""} { beep ; message "You must enter a name." }
  873.     }    
  874.     if {$modes == ""} {set modes "*"}
  875.     if {$filetype == "Either"} {set filetype "*"}
  876.     if {$proj == "None"} {set proj "*"}
  877.     if {$procedure == ""} {set procedure "\#"}
  878.     return [list $modes $name $filetype $procedure $proj $subproj]
  879.     
  880. }
  881.  
  882. proc global::editDocumentTemplate {} {
  883.     global modifiedVars elec::DocTemplates
  884.     set tlist [file::docTemplates] 
  885.     set l [listpick -p "Which document template do you want to edit?" $tlist]
  886.     set lind [file::docTemplateIndex $l]
  887.     set l [global::_editDocumentTemplate [file::docTemplateInfo $l]]
  888.     set elec::DocTemplates [lreplace ${elec::DocTemplates} $lind $lind $l]
  889.     lappend modifiedVars elec::DocTemplates
  890. }
  891.  
  892. proc global::removeDocumentTemplate {} {
  893.     global modifiedVars elec::DocTemplates
  894.     set tlist [file::docTemplates] 
  895.     set l [listpick -p "Which document template shall I permanently remove?" $tlist]
  896.     set l [file::docTemplateIndex $l]
  897.     set elec::DocTemplates [lreplace ${elec::DocTemplates} $l $l]
  898.     lappend modifiedVars elec::DocTemplates
  899. }
  900.  
  901. ## Create this sort of stuff.
  902.  # set docProject(name) [list    "None" "EvoX" "Vince's Additions" "Cpptcl"]
  903.  # set docProject(addendum) {    {none} {evolution in complex systems} \
  904.  #       {an extension package for Alpha}    {connecting    C++    with Tcl} }
  905.  # set docProject(default_modes) { {}    {C C++}    {Tcl} {C C++ Tcl}}
  906.  ##
  907. proc global::newProject {} {
  908.     global docProject
  909.     set res [global::_editProject]
  910.     set i -1
  911.     foreach var {name addendum license extra default_modes} {
  912.         lappend docProject($var) [lindex $res [incr i]]
  913.     }
  914.     global modifiedArrVars
  915.     lappend modifiedArrVars docProject
  916.     addMenuItem -m {Current Project} [lindex $res 0]
  917.     Docproj::changeProject [lindex $res 0]
  918. }
  919. proc global::_editProject {{def ""}} {
  920.     if {$def == ""} {
  921.         set title "Create a new project"
  922.         set def [list "Vince's Additions" "an extension package for Alpha" "license.terms" "See the file \"license.terms\" for information on usage and redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES." ""]
  923.     } else {
  924.         set title "Edit a project"
  925.     }
  926.     set y 40
  927.     set yb 270
  928.     global elec::LicenseTemplates
  929.     set res [eval dialog -w 380 -h 325 \
  930.     [dialog::title $title 360] \
  931.     [dialog::button "OK" 290 yb] \
  932.     [dialog::button "Cancel" 290 yb] \
  933.     [dialog::textedit "Short Descriptive Name" [lindex $def 0] 10 y 15] \
  934.     [dialog::textedit "Longer Description to append to the above" [lindex $def 1] 10 y 25] \
  935.     [dialog::text "License type for header comments" 10 y] \
  936.     [dialog::menu 10 y ${elec::LicenseTemplates} [lindex $def 2]] \
  937.     [dialog::textedit "Additional text for end of header comments" [lindex $def 3] 10 y 35 5] \
  938.     [dialog::textedit "Modes (blank = all)" [lindex $def 4] 10 y 15] \
  939.     ]
  940.     if [lindex $res 1] { error "Cancel" }
  941.     return [lrange $res 2 6]    
  942. }
  943.  
  944. proc global::editProject {} {
  945.     global docProject modifiedArrVars
  946.     set l [listpick -p "Which project do you wish to edit?" \
  947.         -L [file::projectName] $docProject(name)]
  948.     set item [lsearch -exact $docProject(name) $l]
  949.     foreach uvar {name addendum license extra default_modes} {
  950.         lappend def [lindex $docProject($uvar) $item]
  951.     }
  952.     set def [global::_editProject $def]
  953.     set i -1
  954.     foreach uvar {name addendum license extra default_modes} {
  955.         set docProject($uvar) [lreplace $docProject($uvar) $item $item [lindex $def [incr i]]]
  956.     }
  957.     lappend modifiedArrVars docProject
  958. }
  959.  
  960. proc global::removeProject {} {
  961.     global docProject modifiedArrVars
  962.     set l [listpick -p "Which project shall I permanently remove?" $docProject(name)]
  963.     set item [lsearch -exact $docProject(name) $l]
  964.     foreach uvar {name addendum license extra default_modes} {
  965.         set docProject($uvar) [lreplace $docProject($uvar) $item $item]
  966.     }
  967.     lappend modifiedArrVars docProject
  968.     if {[file::projectName] == $l} {
  969.         Docproj::changeProject "None"
  970.     }
  971.     deleteMenuItem -m {Current Project} $l
  972. }
  973.  
  974.